Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/score/score1.bas

BASIC Source File | 1995-06-17 | 7KB | 207 lines

Option Explicit
'------------------------------------------------------------
' SCORE1.BAS
'------------------------------------------------------------

' Constant used to display the form modally.
Const MODAL = 1

' The maximum number of High Scores tracked.
Const MAX_HISCORES = 5

' Used when calling the two API functions below.
Const SECTION = "HiScores"
Const ENTRY = "Score"

' Two Windows API calls used to read and write private .INI files.
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpSectionName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpSectionName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer

' The data structure that stores high scores.
Type tScores
    Name As String
    Score As Long
End Type

' This should ALWAYS be set to MAX_HISCORES + 1.
Global Hi(1 To 6) As tScores

' The current number of high scores stored in Hi() array.
Global Num_HiScores As Integer

' The new score to test.
Global gNewScore As Long

' The .INI file to store scoring information.
Global gINIFile As String

' This global boolean tells the form to just display
' the high scores (no player name data entry).
Global gDisplayOnly As Integer

' The game title displayed as the form caption
' of the High Score window.
Global gGameTitle As String

Sub AddScoreAndSave (ByVal NewName As String, ByVal NewScore As Long)
'------------------------------------------------------------
' Add this new score to the list of high scores and save
' everything back to the .INI file.
'------------------------------------------------------------
Dim i As Integer
Dim j As Integer
Dim temp As tScores

    ' Add the new score to the end of the Hi() array.
    Hi(Num_HiScores + 1).Name = NewName
    Hi(Num_HiScores + 1).Score = NewScore

    ' Bubble-sort the scores in descending order (highest first) ...
    For j = 1 To Num_HiScores + 1
        For i = 2 To Num_HiScores + 1
            If Hi(i).Score > Hi(i - 1).Score Then
                temp = Hi(i - 1)
                Hi(i - 1) = Hi(i)
                Hi(i) = temp
            End If
        Next
    Next

    If Num_HiScores < MAX_HISCORES Then Num_HiScores = Num_HiScores + 1

    ' Write the scores back to the .INI file.
    For i = 1 To Num_HiScores
        WriteScore gINIFile, i, Format$(Hi(i).Score) & ";" & Trim$(Hi(i).Name)
    Next

End Sub

Sub GetScores (INIFile As String)
'------------------------------------------------------------
' Read scores from the .INI file and store them in the Hi()
' array.  In the .INI file, the score and player's name are
' stored together, separated by a semi-colon like this:
'
' ENTRY1=9999;name
'
' We separate the two pieces of data after reading them in.
'------------------------------------------------------------
Dim i As Integer
Dim rc As Integer
Dim pos As Integer
Dim AString As String
Dim DefValue As String


    For i = 1 To MAX_HISCORES
        AString = Space$(255)

        ' Windows API call to retrieve data from an .INI file.
        rc = GetPrivateProfileString(SECTION, ENTRY & Format$(i), "", AString, 255, INIFile)

        If rc > 0 Then
            ' rc tells us the length of the returned string,
            ' so we truncate the string at that length.
            AString = Left$(AString, rc)

            ' Separate the player's name and score.
            pos = InStr(AString, ";")
            If pos > 0 Then
                Hi(i).Score = Left(AString, pos - 1)
                Hi(i).Name = Mid$(AString, pos + 1)
            End If
        Else
            Num_HiScores = i - 1
            Exit Sub
        End If
    Next
    Num_HiScores = MAX_HISCORES
End Sub

Function IsAHiScore (NewScore As Long) As Integer
'------------------------------------------------------------
' Returns True if NewScore is a High Score, False otherwise.
'------------------------------------------------------------
Dim i As Integer

    ' Assume that it's not a high score.
    IsAHiScore = False

    If Num_HiScores > 0 Then
        ' If we've only equalled the lowest high score,
        ' then don't bother...
        If Num_HiScores = MAX_HISCORES And (NewScore = Hi(Num_HiScores).Score) Then
            Exit Function
        End If
    End If

    ' If we haven't filled up the High Scores table,
    ' then this must be a new high score.
    If Num_HiScores < MAX_HISCORES Then
        IsAHiScore = True
        Exit Function
    End If

    ' Compare this new score to the existing high scores.
    For i = 1 To Num_HiScores
        If Hi(i).Score <= NewScore Then
            IsAHiScore = True
            Exit For
        End If
    Next

End Function

Sub Main ()
'------------------------------------------------------------
' This test procedure should be removed when using this
' module in your programs.  It's included to show the proper
' way to call the ShowHiScores routine.
'------------------------------------------------------------
Dim Score As Long

    On Error Resume Next
    Score = CLng(Command$)

    ShowHiScores Score, "My Game", "MYAPP2.INI", True
    End
End Sub

Sub ShowHiScores (ByVal NewScore As Long, ByVal GameTitle As String, ByVal INIFile As String, ByVal DisplayOnly As Integer)
'------------------------------------------------------------
' Call this routine after a game is completed, passing it
' the score of the game and the .INI file where your game's
' high scores are stored.  If the new score is a new high,
' then a form is displayed where the player can enter their
' name.  This information is then stored back in the .INI file.
'------------------------------------------------------------

    gINIFile = INIFile
    gGameTitle = GameTitle

    ' Get the current high scores from the .INI file.
    GetScores gINIFile

    If DisplayOnly Then
        gDisplayOnly = True
        frmScores.Show MODAL
    Else
        ' If this is a new high, then display the High Score form.
        If IsAHiScore(NewScore) Then
            gNewScore = NewScore
            frmScores.Show MODAL
        End If
    End If
End Sub

Sub WriteScore (ByVal FileName As String, EntryNum As Integer, ByVal AString As String)
'------------------------------------------------------------
' Write a high score back to the .INI file.
'------------------------------------------------------------
Dim rc As Integer

    ' Windows API call to write to a private .INI file.
    rc = WritePrivateProfileString(SECTION, ENTRY & Format$(EntryNum), AString, FileName)
End Sub